home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / ENTRY.SWG / 0004_General Purpos Line Edit.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-22  |  7KB  |  238 lines
  1. (****************************************************************)
  2. (*                         N_EditLn                             *)
  3. (*                                                              *)
  4. (*    General Purpose line editor, based on EDITLN by Borland   *)
  5. (*          Modified for use with multiple lines by             *)
  6. (*                 Bob Gibson of BGShareWare                    *)
  7. (*                                                              *)
  8. (****************************************************************)
  9.  
  10. unit N_EditLn;
  11. {$D-,I-,S-}
  12. interface
  13. uses Scrn;
  14.  
  15. const
  16.   NULL = #0;
  17.   BS = #8;
  18.   LF = #10;
  19.   CR = #13;
  20.   ESC = #27;
  21.   Space = #32;
  22.   Tab = ^I;
  23.  
  24.   { The following constants are based on the scheme used by the scan key
  25.     function to convert a two key scan code sequence into one character
  26.     by adding 128 to the ordinal value of the second character.
  27.   }
  28.   F1 = #187;
  29.   F2 = #188;
  30.   F3 = #189;
  31.   F4 = #190;
  32.   F5 = #191;
  33.   F6 = #192;
  34.   F7 = #193;
  35.   F8 = #194;
  36.   F9 = #195;
  37.   F10 = #196;
  38.   UpKey = #200;
  39.   DownKey = #208;
  40.   LeftKey = #203;
  41.   RightKey = #205;
  42.   PgUpKey = #201;
  43.   PgDnKey = #209;
  44.   HomeKey = #199;
  45.   EndKey = #207;
  46.   InsKey = #210;
  47.   DelKey = #211;
  48.   M : Word = 0;
  49. var
  50.   O, N, R, P : byte;
  51.   Ch : Char;
  52.   T : String;
  53.  
  54. type
  55.   CharSet = set of char;
  56.  
  57. procedure EditLine(var S     : String;
  58.                        Len, X, Y : byte;
  59.                        LegalChars,
  60.                        Term  : CharSet;
  61.                    var TC    : Char    );
  62. {  EditLn implements a line editor that supports WordStar commands
  63.    as well as left-right arrow keys , Home, End, back space, etc.
  64.    Paramaters:
  65.      S : String to be edited
  66.      Len : Maximum characters allowed to be edited
  67.      X, Y : Starting x an y cordinates
  68.      LegalChars : Set of characters that will be accepted
  69.      Term : Set of characters that will cause EditLine to Exit
  70.             (Note LegalChars need not contain Term)
  71.      TC : Character that caused EditLn to exit
  72. }
  73.  
  74. function ScanKey : char;
  75. { Reads a key from the keyboard and converts 2 scan code escape
  76.   sequences into 1 character. }
  77.  
  78. implementation
  79. {$L keys}
  80. Function KeyPressed : Boolean ; External;
  81. Function ReadKey : Char ; External;
  82.  
  83. function ScanKey : char;
  84. { Reads a key from the keyboard and converts 2 scan code escape
  85.   sequences into 1 character. }
  86.  
  87. var
  88.   Ch : Char;
  89. begin
  90.   Ch := ReadKey;
  91.   if (Ch = #0) {and KeyPressed} then
  92.   begin
  93.     Ch := ReadKey;
  94.     if ord(Ch) < 128 then
  95.       Ch := Chr(Ord(Ch) + 128);
  96.   end;
  97.   ScanKey := Ch;
  98. end; { ScanKey }
  99.  
  100. procedure EditLine(var S : String;
  101.                    Len, X, Y : byte;
  102.                    LegalChars, Term  : CharSet;
  103.                    var TC    : Char);
  104. {  EditLn implements a line editor that supports WordStar commands
  105.    as well as left-right arrow keys , Home, End, back space, etc.
  106.    Paramaters:
  107.      S : String to be edited
  108.      Len : Maximum characters allowed to be edited
  109.      X, Y : Starting x an y cordinates
  110.      LegalChars : Set of characters that will be accepted
  111.      Term : Set of characters that will cause EditLine to Exit
  112.             (Note LegalChars need not contain Term)
  113.      TC : Character that caused EditLn to exit
  114. }
  115. {$V-}
  116.  
  117. begin
  118.   PXY(X,Y);
  119.   PWrite(S);
  120.   P := Y - 1;
  121.   N := Y;
  122.   O := X;
  123.   Y := 1;
  124.   M := 0;
  125.   Mem[$40:$17] := (Mem[$40:$17] AND $7F);
  126.   repeat
  127.     If ((Mem[$40:$17] AND $80) = $80) Then SetCursor(0,7) Else SetCursor(6,7);
  128.     If (Y+P) > 80 Then Begin
  129.        Inc(X);
  130.        P := 0;
  131.        End;
  132.     PXY(X,Y+P);
  133.     Ch := ScanKey;
  134.     if not (Upcase(Ch) in Term) then
  135.       case Ch of
  136.         #32..#126 : if (M < Len) and
  137.                        (ch in LegalChars) then
  138.                     begin
  139.                       P := succ(P);
  140.                       M := succ(M);
  141.                       If ((Mem[$40:$17] AND $80) = $80) Then
  142.                         Delete(S,M,1);
  143.                       If ((Mem[$40:$17] AND $80) <> $80) Then
  144.                          If Length(S) = Len Then Delete(S,Len,1);
  145.                       Insert(Ch,S,M);
  146.                       T := Copy(S,M,Len);
  147.                       PWrite(T);
  148.                     end
  149.                     Else Writeln(^G);
  150.         ^S, LeftKey : if M > 0 then Begin
  151.                         If P < 1 Then Begin
  152.                            P := 80;
  153.                            Dec(X);
  154.                            End;
  155.                         P := pred(P);
  156.                         M := pred(M);
  157.                         End;
  158.         ^D, RightKey : if M < Length(S) then Begin
  159.                          P := succ(P);
  160.                          M := succ(M);
  161.                          End;
  162.          HomeKey : Begin
  163.                         M := M - P;
  164.                         P := 0;
  165.                         End;
  166.          EndKey : Begin
  167.                         M := M + (79 - P);
  168.                         P := 79;
  169.                         If M > Length(S) Then Begin
  170.                            P := P - (M - Length(S));
  171.                            M := Length(S);
  172.                            End;
  173.                         End;
  174.          UpKey : If X > O Then Begin
  175.                         Dec(X);
  176.                         M := M - 80;
  177.                         End;
  178.          DownKey : If (M+80) < Length(S) Then Begin
  179.                         Inc(X);
  180.                         M := M + 80;
  181.                         If M > Length(S) Then Begin
  182.                            P := P - (M - Length(S));
  183.                            M := Length(S);
  184.                            End;
  185.                         End;
  186.          DelKey  : if M < Length(S) then
  187.                        begin
  188.                          Delete(S,M + 1,1);
  189.                          T := Copy(S,M+1,Len);
  190.                          T := T + ' ';
  191.                          PWrite(T);
  192.                        end;
  193.          BS : if M > 0 then
  194.                  begin
  195.                    Delete(S,M,1);
  196.                    T := Copy(S,M,Len);
  197.                    If (Y+P-1) < 1 Then Begin
  198.                       Dec(X);
  199.                       P := (81-Y);
  200.                       PXY(X,P);
  201.                       End
  202.                    Else PXY(X,Y+P-1);
  203.                    T := T + ' ';
  204.                    PWrite(T);
  205.                    P := pred(P);
  206.                    M := pred(M);
  207.                  end;
  208.          F9 : Begin
  209.                   X := O;
  210.                   Y := 1;
  211.                   For R := 1 To Len Do PWrite(' ');
  212.                   P := 0;
  213.                   S := '';
  214.                   M := 0;
  215.                   End;
  216.       else;
  217.     end;  {of case}
  218.   until UpCase(Ch) in Term;
  219.   SetCursor(6,7);
  220.   PXY(X,Y+P);
  221.   M := Length(S);
  222.   For R := 1 To (Len-M) Do PWrite('');
  223.   TC := Upcase(Ch);
  224. end; { EditLine }
  225.  
  226. end.
  227.  
  228. USE XX34 to decode this object code.  You MUST Have it to use this unit
  229. Also, you will need the SCRN.PAS from the SCREEN.SWG packet.
  230.  
  231.  
  232. *XX3401-000092-070293--68--85-59342--------KEYS.OBJ--1-OF--1
  233. U+M+-2h3KJAuZUQ+++F1HoF3F7U5+0UI++6-+G4E5++++Ed9FJZEIYJHIoJ2++++-p73
  234. EIF9FJY7+++pc-U++E++h+5B3bHug+51JMjgh+TB6MjZLQD6WU6++5E+
  235. ***** END OF XX-BLOCK *****
  236.  
  237.  
  238.